;;(load "ut.scm")


(defmacro run/err2lisp(car-key l fn)
  (let ((--exit (intern (format "exit-%s" fn)))(r (cl-gensym)))
  `(let ((,r ,l))
     (if (eq (car ,r) ',car-key)
	 (cl-return-from ,--exit ,r)
	 ,r))))
(defmacro r/err2lisp(car-key l fn)
  (let ((--exit (intern (format "exit-~a" fn)))(r1 (cl-gensym)))
  `(let ((,r1 ,l))
     (if (eq ,r1 ',car-key)
	 (cl-return-from ,--exit ,r1)
	 ,r1))))
(defmacro err2lisp(car-key l fn)
  (let ((--exit (intern (format "exit-%s" fn)))(r (cl-gensym)))
  `(let ((,r ,l))
     (cond
      ((atom ,r)
       (if (eq ,r ',car-key)
	   (cl-return-from ,--exit ,r)
	   ,r))
      ((consp ,r)
       (if (eq (car ,r) ',car-key)
	   (cl-return-from ,--exit ,r)
	   ,r))))))
      
;;run/err function must return a list. it's first element is 'err if a error occurs.
(defmacro run/err(fn &rest par) `(funcall ,fn ,@par))
;;r/err function must return a value return. it's first element is 'err if a error occurs.
(defmacro r/err(fn &rest par) `(funcall ,fn ,@par))


(defun lisp-find/tr(car-key res-car-key l key-handle fn)
  (cond
   ((null l) nil)
   ((atom l) l)
   ((and (listp l)(listp (car l)))
    (cons (lisp-find/tr car-key res-car-key (car l) key-handle fn)
	  (lisp-find/tr car-key res-car-key (cdr l) key-handle fn)))
   ((and (listp l)(atom (car l))(eq (car l) car-key))
    (funcall key-handle res-car-key l fn))
   ((and (listp l)(atom (car l))(not (eq (car l) car-key)))
    (cons (car l) (lisp-find/tr car-key res-car-key (cdr l) key-handle fn)))
   (t (format  "错误提示:[%s]非法到达，开发错误。 " l))))



(defmacro def/err(fn-l &rest body)
  (let ((newbody (lisp-find/tr 'run/err 'err body ’err2lisp (car fn-l)))
	(name (car fn-l))
	(par-l (cdr fn-l))      
	(exit-label (intern (format "exit-%s" (car fn-l))))
	)
    `(defun ,name ,par-l
       (cl-block ,exit-label ,@newbody))))

(defmacro define-macro/err(fn-l &rest body)
  (if (and (listp fn-l)(>= (length fn-l) 2))
      (let ((newbody (lisp-find/tr 'run/err 'err body ‘err2lisp (cadr fn-l)))
	    (name (car fn-l))
	    (par-l (nthcdr 2 fn-l))
	    )
	`(defmacro ,name ,par-l
	   ,@newbody))
  (display "PANIC:define-macro/err macro has too few parameters[~a],should big than 2." (length fn-l))))

(defmacro let-set!(var-l f-l)
  (if (atom var-l)
      (message "let-set!宏不允许参数列表是符号或空列表。")
    (let ((r (cl-gensym))(e (car var-l))(len (length var-l)))
      (if (and (listp var-l)(= (length var-l) 1))
	  `(let ((,r ,f-l))
	     (if (consp ,r)
		 (setq ,e (car ,r))
	       (setq ,e ,r)))
	`(let ((,r ,f-l))
	   (if (consp ,r)
	       (progn
		 (setq ,e (car ,r))
		 (let-set! ,(cdr var-l) (cdr ,r)))
	     (progn
	       (setq ,e ,r)
	       (let-set! ,(cdr var-l) nil))))
	))))
	    
	
	 
  
	 
;;these are tests for verify the def/err def/el def/e1 function as below.
;;(define (p1 a) (if (> a 0) a 'err))
;;(define (p2 a b) (if (> a 0) (list a (+ a b)) '(err "a<0 illegal.")))
;;(define (ppp a b)
;;  (cond
;;   ((> a 0) (+ (car (run/err p2 b a)) a))
;;   ((= a 0) 0)
;;   ((< a 0) (+ (r/err p1 b) a))))
;;(def/err (pppll a b)
;;  (cond
;;   ((> a 0) (+ (car (run/err p2 b a)) a))
;;   ((= a 0) 0)
;;   ((< a 0) (+ (r/err p1 b) a))))
;;(def/el (pppl a b)
;;  (cond
;;   ((> a 0) (run/err p2 b a) a)
;;   ((= a 0) 0)
;;   ((< a 0) b)))
;;(def/e1 (ppp1 a b)
;;  (cond
;;   ((> a 0) a)
;;   ((= a 0) 0)
;;   ((< a 0) (r/err p1 b) b)))
;;(ppp 2 3)==>5
;;(ppp 2 -3)==>illegal
;;(ppp -2 3)==>1
;;(ppp -2 -3)==>illegal

;;(pppll 2 3)==>5
;;(pppll 2 -3)==>'(err "a<0 illegal")
;;(pppll -2 3)==>1
;;(pppll -2 -3)==>'err

;;(pppl 2 3)==>5
;;(pppl 2 -3)==>'(err "a<0 illegal")

;;(ppp1 -2 3)==>1
;;(ppp1 -2 -3)==>'err
;;def/err函数支持返回为列表和单值的函数。如果是列表，则其第一个元素表示返回结果出错与否，返回'err表示出错。返回其他则是可接受返回值。如果是单值，则使用'err代表出错，其他值表示允许值。任何需要调用以这种规则返回的函数需要逐级返回到最顶级并进行错误处理的情况，在调用函数时区分列表返回（使用run/err调用）、单值返回（使用r/err调用）。
;;在顶级调用位置需要使用错误处理函数进行错误处理。


(defmacro def/ret(fn-l &rest body)
  (let ((name (car fn-l))(par-l (cdr fn-l))(exit-label (intern (format "exit-%s" (car fn-l)))))
  `(defun ,name-l ,par-l (cl-block ,exit-label ,@body))))

(defmacro define-macro/ret(fn-l &rest body)
  (if (and (pair? fn-l)(>= (length fn-l) 2))
      (let ((name (car fn-l))(par-l (nthcdr 2 fn-l))
	    (exit-label (intern (format "exit-&s" (nth 1 fn-l))))
	    )
	`(defmacro ,name ,par-l
	   (cl-block ,exit-label
	   ,@body)))
      (display "PANIC:define-macro/err macro has too few parameters[~a],should big than 2." (length fn-l))))
(defmacro def/rest(fn a b)
    (let ((new-fn (intern (format "%s、..." fn)))
	  (s (cl-gensym))
	  (i (cl-gensym))
	  (e (cl-gensym))
	  )
    `(defun ,new-fn(,a &rest ,b)
       (let ((s  (,fn ,a (car ,b))))
	 (tr-list (,i ,e ,b 1)
		  (set! ,s (,fn ,s ,e)))
	 ,s))))
(defmacro def/scm-rest(fn  a)
  (let ((new-fn (intern (format "【*】%s、..." fn)))
	)
    `(defun ,new-fn(&rest ,a)
      (apply ,fn ,a))))
		
